home *** CD-ROM | disk | FTP | other *** search
/ PCGUIA 127 / PC Guia 127.iso / Software / Utils / GParted Live CD / Bin / gparted-livecd-0.2.2.iso / usr_sqfs / bin / rftp < prev    next >
Encoding:
Text File  |  2005-07-18  |  8.6 KB  |  338 lines
  1. #!/bin/sh
  2. # \
  3. exec expect -f "$0" ${1+"$@"}
  4. # rftp - ftp a directory hierarchy (i.e. recursive ftp)
  5. # Version 2.10
  6. # Don Libes, NIST
  7. exp_version -exit 5.0
  8.  
  9. # rftp is much like ftp except that the command ~g copies everything in
  10. # the remote current working directory to the local current working
  11. # directory.  Similarly ~p copies in the reverse direction.  ~l just
  12. # lists the remote directories.
  13.  
  14. # rftp takes an argument of the host to ftp to.  Username and password
  15. # are prompted for.  Other ftp options can be set interactively at that
  16. # time.  If your local ftp understands .netrc, that is also used.
  17.  
  18. # ~/.rftprc is sourced after the user has logged in to the remote site
  19. # and other ftp commands may be sent at that time.  .rftprc may also be
  20. # used to override the following rftp defaults.  The lines should use
  21. # the same syntax as these:
  22.  
  23. set file_timeout 3600        ;# timeout (seconds) for retrieving files
  24. set timeout 1000000        ;# timeout (seconds) for other ftp dialogue
  25. set default_type binary        ;# default type, i.e., ascii, binary, tenex
  26. set binary {}            ;# files matching are transferred as binary
  27. set ascii {}            ;# as above, but as ascii
  28. set tenex {}            ;# as above, but as tenex
  29.  
  30. # The values of binary, ascii and tenex should be a list of (Tcl) regular
  31. # expressions.  For example, the following definitions would force files
  32. # ending in *.Z and *.tar to be transferred as binaries and everything else
  33. # as text.
  34.  
  35. # set default_type ascii
  36. # set binary {*.Z *.tar}
  37.  
  38. # If you are on a UNIX machine, you can probably safely ignore all of this
  39. # and transfer everything as "binary".
  40.  
  41. # The current implementation requires that the source host be able to
  42. # provide directory listings in UNIX format.  Hence, you cannot copy
  43. # from a VMS host (although you can copy to it).  In fact, there is no
  44. # standard for the output that ftp produces, and thus, ftps that differ
  45. # significantly from the ubiquitous UNIX implementation may not work
  46. # with rftp (at least, not without changing the scanning and parsing).
  47.  
  48. ####################end of documentation###############################
  49.  
  50. match_max -d 100000        ;# max size of a directory listing
  51.  
  52. # return name of file from one line of directory listing
  53. proc getname {line} {
  54.     # if it's a symbolic link, return local name
  55.     set i [lsearch $line "->"]
  56.     if {-1==$i} {
  57.     # not a sym link, return last token of line as name
  58.     return [lindex $line [expr [llength $line]-1]]
  59.     } else {
  60.     # sym link, return "a" of "a -> b"
  61.     return [lindex $line [expr $i-1]]
  62.     }
  63. }
  64.  
  65. proc putfile {name} {
  66.     global current_type default_type
  67.     global binary ascii tenex
  68.     global file_timeout
  69.  
  70.     switch -- $name    $binary    {set new_type binary} \
  71.           $ascii    {set new_type ascii} \
  72.           $tenex    {set new_type tenex} \
  73.           default    {set new_type $default_type}
  74.  
  75.     if {$current_type != $new_type} {
  76.     settype $new_type
  77.     }
  78.  
  79.     set timeout $file_timeout
  80.     send "put $name\r"
  81.     expect timeout {
  82.     send_user "ftp timed out in response to \"put $name\"\n"
  83.     exit
  84.     } "ftp>*"
  85. }
  86.  
  87. proc getfile {name} {
  88.     global current_type default_type
  89.     global binary ascii tenex
  90.     global file_timeout
  91.  
  92.     switch -- $name    $binary    {set new_type binary} \
  93.           $ascii    {set new_type ascii} \
  94.           $tenex    {set new_type tenex} \
  95.           default    {set new_type $default_type}
  96.  
  97.     if {$current_type != $new_type} {
  98.     settype $new_type
  99.     }
  100.  
  101.     set timeout $file_timeout
  102.     send "get $name\r"
  103.     expect timeout {
  104.     send_user "ftp timed out in response to \"get $name\"\n"
  105.     exit
  106.     } "ftp>*"
  107. }
  108.  
  109. # returns 1 if successful, 0 otherwise
  110. proc putdirectory {name} {
  111.     send "mkdir $name\r"
  112.     expect "550*denied*ftp>*" {
  113.     send_user "failed to make remote directory $name\n"
  114.     return 0
  115.     } timeout {
  116.     send_user "timed out on make remote directory $name\n"
  117.     return 0
  118.     } -re "(257|550.*exists).*ftp>.*"
  119.     # 550 is returned if directory already exists
  120.  
  121.     send "cd $name\r"
  122.     expect "550*ftp>*" {
  123.     send_user "failed to cd to remote directory $name\n"
  124.     return 0
  125.     } timeout {
  126.     send_user "timed out on cd to remote directory $name\n"
  127.     return 0
  128.     } -re "2(5|0)0.*ftp>.*"
  129.     # some ftp's return 200, some return 250
  130.  
  131.     send "lcd $name\r"
  132.     # hard to know what to look for, since my ftp doesn't return status
  133.     # codes.  It is evidentally very locale-dependent.
  134.     # So, assume success.
  135.     expect "ftp>*"
  136.     putcurdirectory
  137.     send "lcd ..\r"
  138.     expect "ftp>*"
  139.     send "cd ..\r"
  140.     expect timeout {
  141.     send_user "failed to cd to remote directory ..\n"
  142.     return 0
  143.     } -re "2(5|0)0.*ftp>.*"
  144.  
  145.     return 1
  146. }
  147.  
  148. # returns 1 if successful, 0 otherwise
  149. proc getdirectory {name transfer} {
  150.     send "cd $name\r"
  151.     # this can fail normally if it's a symbolic link, and we are just
  152.     # experimenting
  153.     expect "550*$name*ftp>*" {
  154.     send_user "failed to cd to remote directory $name\n"
  155.     return 0
  156.     } timeout {
  157.     send_user "timed out on cd to remote directory $name\n"
  158.     return 0
  159.     } -re "2(5|0)0.*ftp>.*"
  160.     # some ftp's return 200, some return 250
  161.  
  162.     if {$transfer} {
  163.     send "!mkdir $name\r"
  164.     expect "denied*" return timeout return "ftp>"
  165.     send "lcd $name\r"
  166.     # hard to know what to look for, since my ftp doesn't return
  167.     # status codes.  It is evidentally very locale-dependent.
  168.     # So, assume success.
  169.     expect "ftp>*"
  170.     }
  171.     getcurdirectory $transfer
  172.     if {$transfer} {
  173.     send "lcd ..\r"
  174.     expect "ftp>*"
  175.     }
  176.     send "cd ..\r"
  177.     expect timeout {
  178.     send_user "failed to cd to remote directory ..\n"
  179.     return 0
  180.     } -re "2(5|0)0.*ftp>.*"
  181.  
  182.     return 1
  183. }
  184.  
  185. proc putentry {name type} {
  186.     switch -- $type d {
  187.     # directory
  188.     if {$name=="." || $name==".."} return
  189.     putdirectory $name
  190.     } - {
  191.     # file
  192.     putfile $name
  193.     } l {
  194.     # symlink, could be either file or directory
  195.     # first assume it's a directory
  196.     if {[putdirectory $name]} return
  197.     putfile $name
  198.     } default {
  199.     send_user "can't figure out what $name is, skipping\n"
  200.     }
  201. }
  202.  
  203. proc getentry {name type transfer} {
  204.     switch -- $type d {
  205.     # directory
  206.     if {$name=="." || $name==".."} return
  207.     getdirectory $name $transfer
  208.     } - {
  209.     # file
  210.     if {!$transfer} return
  211.     getfile $name
  212.     } l {
  213.     # symlink, could be either file or directory
  214.     # first assume it's a directory
  215.     if {[getdirectory $name $transfer]} return
  216.     if {!$transfer} return
  217.     getfile $name
  218.     } default {
  219.     send_user "can't figure out what $name is, skipping\n"
  220.     }
  221. }
  222.  
  223. proc putcurdirectory {} {
  224.     send "!/bin/ls -alg\r"
  225.     expect timeout {
  226.     send_user "failed to get directory listing\n"
  227.     return
  228.     } "ftp>*"
  229.  
  230.     set buf $expect_out(buffer)
  231.  
  232.     while {1} {
  233.     # if end of listing, succeeded!
  234.     if 0==[regexp "(\[^\n]*)\n(.*)" $buf dummy line buf] return
  235.  
  236.     set token [lindex $line 0]
  237.     switch -- $token !/bin/ls {
  238.         # original command
  239.     } total {
  240.         # directory header
  241.     } . {
  242.         # unreadable
  243.     } default {
  244.         # either file or directory
  245.         set name [getname $line]
  246.         set type [string index $line 0]
  247.         putentry $name $type
  248.     }
  249.     }
  250. }
  251.  
  252. # look at result of "dir".  If transfer==1, get all files and directories
  253. proc getcurdirectory {transfer} {
  254.     send "dir\r"
  255.     expect timeout {
  256.     send_user "failed to get directory listing\n"
  257.     return
  258.     } "ftp>*"
  259.  
  260.     set buf $expect_out(buffer)
  261.  
  262.     while {1} {
  263.     regexp "(\[^\n]*)\n(.*)" $buf dummy line buf
  264.  
  265.     set token [lindex $line 0]
  266.     switch -- $token dir {
  267.         # original command
  268.     } 200 {
  269.         # command successful
  270.     } 150 {
  271.         # opening data connection
  272.     } total {
  273.         # directory header
  274.     } 226 {
  275.         # transfer complete, succeeded!
  276.         return
  277.     } ftp>* {
  278.         # next prompt, failed!
  279.         return
  280.     } . {
  281.         # unreadable
  282.     } default {
  283.         # either file or directory
  284.         set name [getname $line]
  285.         set type [string index $line 0]
  286.         getentry $name $type $transfer
  287.     }
  288.     }
  289. }
  290.  
  291. proc settype {t} {
  292.     global current_type
  293.  
  294.     send "type $t\r"
  295.     set current_type $t
  296.     expect "200*ftp>*"
  297. }
  298.  
  299. proc final_msg {} {
  300.     # write over the previous prompt with our message
  301.     send_user "\rQuit ftp or cd to another directory and press ~g, ~p, or ~l\n"
  302.     # and then reprompt
  303.     send_user "ftp> "
  304. }
  305.  
  306. if {[file readable ~/.rftprc]} {source ~/.rftprc}
  307. set first_time 1
  308.  
  309. if {$argc>1} {
  310.     send_user "usage: rftp [host]"
  311.     exit
  312. }
  313.  
  314. send_user "Once logged in, cd to the directory to be transferred and press:\n"
  315. send_user "~p to put the current directory from the local to the remote host\n"
  316. send_user "~g to get the current directory from the remote host to the local host\n"
  317. send_user "~l to list the current directory from the remote host\n"
  318.  
  319. if {$argc==0} {spawn ftp} else {spawn ftp $argv}
  320. interact -echo ~g {
  321.     if {$first_time} {
  322.     set first_time 0
  323.     settype $default_type
  324.     }
  325.     getcurdirectory 1
  326.     final_msg
  327. } -echo ~p {
  328.     if {$first_time} {
  329.     set first_time 0
  330.     settype $default_type
  331.     }
  332.     putcurdirectory
  333.     final_msg
  334. } -echo ~l {
  335.     getcurdirectory 0
  336.     final_msg
  337. }
  338.